home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / timidsrc.zip / tkpanel.tcl < prev    next >
Text File  |  1996-03-29  |  15KB  |  667 lines
  1. #!/usr/local/bin/wishx -f
  2. #
  3. # TkMidity -- Tcl/Tk Interface for TiMidity
  4. #    written by Takashi IWAI
  5. #
  6. # Tk control panel routine
  7. #
  8.  
  9. #----------------
  10. # initialize global variables
  11. #
  12. proc InitGlobal {} {
  13.  
  14.     global Stat tk_patchLevel
  15.  
  16.     if [catch {expr $Stat(new_tcltk) == 0 || $Stat(new_tcltk) == 1}] {
  17.     set Stat(new_tcltk) 0
  18.     if [regexp "(\[0-9\]+\.\[0-9\]+)" $tk_patchLevel cur] {
  19.         if {$cur >= 4.0} {
  20.         set Stat(new_tcltk) 1
  21.         }
  22.     }
  23.     }
  24.  
  25.     # time table and volume
  26.     set Stat(MaxSecs) 0
  27.     set Stat(LastSec) 0
  28.     set Stat(TotalTimeStr) "/ 0:00"
  29.     set Stat(CurVol) 100
  30.  
  31.     # message lines
  32.     set Stat(CurMsgs) 0
  33.     set Stat(MaxMsgs) 500
  34.  
  35.     # current status
  36.     set Stat(Playing) 0
  37.     set Stat(Paused) 0
  38.     set Stat(Blinking) 0
  39.  
  40.     # MIDI file list
  41.     set Stat(CurIdx) -1
  42.     set Stat(MaxFiles) 0
  43.     set Stat(FileList) {}
  44.     set Stat(ShuffleList) {}
  45.  
  46.     global Config
  47.     # playing mode
  48.     set Config(RepeatPlay) 0
  49.     set Config(ShufflePlay) 0
  50.     set Config(AutoStart) 0
  51.     set Config(AutoExit) 0
  52.  
  53.     # display configuration
  54.     set Config(Disp:file) 1
  55.     set Config(Disp:time) 1
  56.     set Config(Disp:text) 1
  57.     set Config(Disp:volume) 1
  58.     set Config(Disp:button) 1
  59. }
  60.  
  61.  
  62. #----------------
  63. # read a message from stdin
  64. #
  65. proc HandleInput {} {
  66.     global Stat Config
  67.  
  68.     set mlist [gets stdin]
  69.     set msg [lindex $mlist 0]
  70.  
  71.     if {$msg == "TIME"} {
  72.     # set total time
  73.     set csecs [expr [lindex $mlist 1] / 100]
  74.     set mins [expr $csecs / 60]
  75.     set secs [expr $csecs % 60]
  76.     set Stat(TotalTimeStr) [format "/ %d:%02d" $mins $secs]
  77.     set Stat(MaxSecs) $csecs
  78.     set tics [expr $csecs / 8]
  79.     set tics [expr (($tics + 4) / 5) * 5]
  80.     .body.time.scale configure -tickinterval $tics -to $csecs
  81.     SetTime 0
  82.  
  83.     } elseif {$msg == "MVOL"} {
  84.     # set master volume
  85.     SetVolume [lindex $mlist 1]
  86.  
  87.     } elseif {$msg == "FILE"} {
  88.     # set playing file
  89.     set path [lindex $mlist 1]
  90.     set divs [split $path /]
  91.     set file [lindex $divs [expr [llength $divs] - 1]]
  92.     wm title . "TkMidity: $file"
  93.     wm iconname . "TkMidity: $file"
  94.     AppendMsg "------"
  95.  
  96.     } elseif {$msg == "LIST"} {
  97.     # set file list
  98.     .body.file.list delete 0 end
  99.     set Stat(MaxFiles) [lindex $mlist 1]
  100.     set Stat(FileList) {}
  101.     for {set i 0} {$i < $Stat(MaxFiles)} {incr i} {
  102.         set file [gets stdin]
  103.         .body.file.list insert end $file
  104.         lappend Stat(FileList) $file
  105.     }
  106.     MakeShuffleList
  107.  
  108.     set Stat(CurIdx) -1
  109.     SelectNumber 
  110.  
  111.     } elseif {$msg == "PREV"} {
  112.     # previous file
  113.     set Stat(CurIdx) [expr $Stat(CurIdx) - 1]
  114.     if {$Stat(CurIdx) < 0} {set Stat(CurIdx) 0}
  115.     SelectNumber 
  116.  
  117.     } elseif {$msg == "NEXT" || $msg == "TEND"} {
  118.     # next file
  119.     incr Stat(CurIdx)
  120.     if {$Stat(CurIdx) >= $Stat(MaxFiles)} {
  121.         if {$Config(RepeatPlay)} {
  122.         set Stat(CurIdx) 0
  123.         } elseif {$Config(AutoExit)} {
  124.         QuitCmd
  125.         } else {
  126.         StopCmd
  127.         }
  128.     }
  129.     SelectNumber
  130.  
  131.     } elseif {$msg == "CURT"} {
  132.     # set current time
  133.     SetTime [expr [lindex $mlist 1] / 100]
  134.  
  135.     } elseif {$msg == "CMSG"} {
  136.     # put message
  137.     set type [lindex $mlist 1]
  138.     set str [gets stdin]
  139.     AppendMsg $str
  140.  
  141.     } elseif {$msg == "QUIT"} {
  142.     # quit
  143.     exit
  144.     } elseif {$msg == "RSTA"} {
  145.     # restart file
  146.     SelectNumber
  147.     }
  148. }
  149.  
  150.  
  151. #----------------
  152. # make shuffled list
  153. #
  154. proc MakeShuffleList {} {
  155.     global Stat
  156.     set tmplist {}
  157.     for {set i 0} {$i < $Stat(MaxFiles)} {incr i} {
  158.     lappend tmplist $i
  159.     }
  160.     set Stat(ShuffleList) {}
  161.     set len $Stat(MaxFiles)
  162.     while {$len > 0} {
  163.     set pos [my-random $len]
  164.     lappend Stat(ShuffleList) [lindex $tmplist $pos]
  165.     set tmplist [lreplace $tmplist $pos $pos]
  166.     lappend Stat(ShuffleList) [lindex $tmplist $pos]
  167.     set len [expr $len - 1]
  168.     }
  169. }
  170.  
  171. #
  172. # append a string to message buffer
  173. #
  174. proc AppendMsg {str} {
  175.     global Stat
  176.  
  177.     incr Stat(CurMsgs)
  178.     if {$Stat(CurMsgs) >= $Stat(MaxMsgs)} { ClearMsg }
  179.     .body.text.buf insert end $str\n
  180.     .body.text.buf yview -pickplace end
  181. }
  182.  
  183. #
  184. # clear message buffer
  185. #
  186. proc ClearMsg {} {
  187.     global Stat
  188.     .body.text.buf delete 0.0 end
  189.     .body.text.buf yview 0
  190.     set Stat(CurMsgs) 0
  191. }
  192.  
  193.  
  194. #----------------
  195. # select the file in listbox and load it
  196. #
  197. proc SelectNumber {} {
  198.     global Stat Config
  199.     if {$Stat(new_tcltk)} {
  200.     .body.file.list select clear 0 end
  201.     } else {
  202.     .body.file.list select clear
  203.     }
  204.     set idx -1
  205.     if {$Stat(CurIdx) >= 0 && $Stat(CurIdx) < [llength $Stat(FileList)]} {
  206.     if {$Config(ShufflePlay)} {
  207.         set idx [lindex $Stat(ShuffleList) $Stat(CurIdx)]
  208.     } else {
  209.         set idx $Stat(CurIdx)
  210.     }
  211.     set thefile [lindex $Stat(FileList) $idx]
  212.     }
  213.     if {$idx >= 0 && ![file exists $thefile]} {
  214.     warning "Can't open file \"$thefile\"."
  215.     set idx -1
  216.     }
  217.  
  218.     if {$idx >= 0} {
  219.     if {$Stat(new_tcltk)} {
  220.         .body.file.list select set $idx
  221.     } else {
  222.         .body.file.list select from $idx
  223.         .body.file.list select to $idx
  224.     }
  225.     .body.curfile configure -text\
  226.         "Playing: [lindex $Stat(FileList) $idx]"
  227.     LoadCmd $idx
  228.     set Stat(Playing) 1
  229.     } else {
  230.     SetTime 0
  231.     .body.curfile configure -text "Playing:"
  232.     set Stat(Playing) 0
  233.     set Stat(Paused) 0
  234.     }
  235.     DispButtonPlay
  236. }
  237.  
  238.  
  239. #
  240. # update current time
  241. #
  242. proc SetTime {val} {
  243.     global Stat
  244.     if {$val != $Stat(LastSec)} {
  245.     set Stat(LastSec) $val
  246.     set mins [expr $val / 60]
  247.     set secs [expr $val % 60]
  248.     .body.time.label configure\
  249.         -text [format "%d:%02d %s" $mins $secs $Stat(TotalTimeStr)]
  250.     .body.time.scale set $val
  251.     DispButtonPlay
  252.     }
  253. }
  254.  
  255.  
  256. #
  257. # colorize buttons with each state
  258. #
  259. proc DispButtonPlay {} {
  260.     global Stat
  261.     if {$Stat(Playing)} {
  262.     if {$Stat(Blinking)} {
  263.         set color green
  264.         set Stat(Blinking) 0
  265.     } else {
  266.         set color red
  267.         set Stat(Blinking) 1
  268.     }
  269.     .body.button.play configure -fg $color -activeforeground $color
  270.     } else {
  271.     .body.button.play configure -fg black -activeforeground black
  272.     }
  273.  
  274.     if {$Stat(Playing) && $Stat(Paused)} {
  275.     .body.button.pause configure -fg red -activeforeground red
  276.     } else {
  277.     .body.button.pause configure -fg black -activeforeground black
  278.     }
  279. }    
  280.  
  281.  
  282. #
  283. # update current volume
  284. #
  285. proc SetVolume {val} {
  286.     global Stat
  287.     set Stat(CurVol) $val
  288.     .body.volume.label configure -text [format "Volume: %d%%" $val]
  289.     .body.volume.scale set $val
  290. }
  291.  
  292.  
  293. #----------------
  294. # write message
  295. # messages are: PREV, NEXT, QUIT, FWRD, BACK, RSET, STOP
  296. #    LOAD\n<filename>, JUMP <time>, VOLM <volume>
  297. #
  298.  
  299. proc WriteMsg {str} {
  300.     puts stdout $str
  301.     flush stdout
  302. }
  303.  
  304.  
  305. #----------------
  306. # callback commands
  307. #
  308.  
  309. #
  310. # jump to specified time
  311. #
  312. proc JumpCmd {val} {
  313.     global Stat
  314.     if {$val != $Stat(LastSec)} {
  315.     WriteMsg [format "JUMP %d" [expr $val * 100]]
  316.     }
  317. }
  318.  
  319. #
  320. # change volume amplitude
  321. #
  322. proc VolumeCmd {val} {
  323.     global Stat
  324.     if {$val < 0} {set val 0}
  325.     if {$val > 200} {set val 200}
  326.     if {$val != $Stat(CurVol)} {
  327.     WriteMsg [format "VOLM %d" $val]
  328.     }
  329. }
  330.  
  331. #
  332. # load the specified file
  333. #
  334. proc LoadCmd {idx} {
  335.     global Stat
  336.     WriteMsg "LOAD"
  337.     WriteMsg [lindex $Stat(FileList) $idx]
  338. }
  339.  
  340. #
  341. # play the first file
  342. #
  343. proc PlayCmd {} {
  344.     global Stat
  345.     if {$Stat(Playing) == 0} {
  346.     WriteMsg "NEXT"
  347.     }
  348. }
  349.  
  350. #
  351. # pause music
  352. #
  353. proc PauseCmd {} {
  354.     global Stat
  355.     if {$Stat(Playing)} {
  356.     if {$Stat(Paused)} {
  357.         set Stat(Paused) 0
  358.     } else {
  359.         set Stat(Paused) 1
  360.     }
  361.     DispButtonPlay
  362.     WriteMsg "STOP"
  363.     }
  364. }
  365.  
  366. #
  367. # stop playing
  368. #
  369. proc StopCmd {} {
  370.     global Stat
  371.     if {$Stat(Playing)} {
  372.     WriteMsg "QUIT"
  373.     WriteMsg "XTND"
  374.     set Stat(CurIdx) -1
  375.     SelectNumber
  376.     }
  377. }
  378.  
  379. #
  380. # quit TkMidity
  381. #
  382. proc QuitCmd {} {
  383.     global Config Stat
  384.     set oldpause $Stat(Paused)
  385.     if {!$oldpause} {PauseCmd}
  386.     if {$Config(AutoExit) || [question "Really Quit TkMidity?" 0]} {
  387.     WriteMsg "QUIT"
  388.     WriteMsg "ZAPP"
  389.     return
  390.     }
  391.     if {!$oldpause} {PauseCmd}
  392. }
  393.  
  394. #
  395. # play previous file
  396. #
  397. proc PrevCmd {} {
  398.     global Stat
  399.     if {$Stat(Playing)} {
  400.     WriteMsg "PREV"
  401.     }
  402. }
  403.  
  404. #
  405. # play next file
  406. #
  407. proc NextCmd {} {
  408.     global Stat
  409.     if {$Stat(Playing)} {
  410.     WriteMsg "NEXT"
  411.     }
  412. }
  413.  
  414. proc VolUpCmd {} {
  415.     global Stat
  416.     if {$Stat(Playing)} {
  417.     VolumeCmd [expr $Stat(CurVol) + 10]
  418.     }
  419. }
  420.  
  421. proc VolDownCmd {} {
  422.     global Stat
  423.     if {$Stat(Playing)} {
  424.     VolumeCmd [expr $Stat(CurVol) - 10]
  425.     }
  426. }
  427.  
  428. #----------------
  429. # display configured tables
  430. #
  431. proc DispTables {} {
  432.     global Config
  433.     set allitems {file time text volume button}
  434.  
  435.     foreach i $allitems {
  436.     pack forget .body.$i
  437.     if {$Config(Disp:$i)} {
  438.         pack .body.$i -side top -fill x
  439.     } 
  440.     }
  441. }
  442.  
  443. #
  444. # save configuration and playing mode
  445. #
  446. proc SaveConfig {} {
  447.     global Config ConfigFile
  448.     set fd [open $ConfigFile w]
  449.     if {$fd != ""} {
  450.     puts $fd "global Config"
  451.     foreach i [array names Config] {
  452.         puts $fd "set Config($i) $Config($i)"
  453.     }
  454.     close $fd
  455.     }
  456. }
  457.  
  458. #
  459. # load configuration file
  460. #
  461. proc LoadConfig {} {
  462.     global ConfigFile
  463.     catch {source $ConfigFile}
  464. }
  465.  
  466. #
  467. # selection callback of the playing file from listbox
  468. #
  469. proc SelectList {lw pos} {
  470.     global Stat
  471.     set idx [$lw nearest $pos]
  472.     if {$idx >= 0 && $idx < $Stat(MaxFiles)} {
  473.     set Stat(CurIdx) $idx
  474.     set Stat(Playing) 1
  475.     SelectNumber
  476.     }
  477. }
  478.     
  479.  
  480. #
  481. #
  482. #
  483. proc OpenFiles {} {
  484.     global Stat
  485.     set files [filebrowser .browser "" "*.mid*"]
  486.     if {$files != ""} {
  487.     set Stat(MaxFiles) [expr $Stat(MaxFiles) + [llength $files]]
  488.     foreach i $files {
  489.         .body.file.list insert end $i
  490.         lappend Stat(FileList) $i
  491.     }
  492.     MakeShuffleList
  493.     }
  494. }
  495.  
  496. #
  497. #
  498. #
  499. proc CloseFiles {} {
  500.     global Stat
  501.     if {[question "Really Clear List?" 0]} {
  502.     StopCmd
  503.     .body.file.list delete 0 end
  504.     set Stat(MaxFiles) 0
  505.     set Stat(FileList) {}
  506.     set Stat(SuffleList) {}
  507.     }
  508. }
  509.  
  510. #----------------
  511. # create main window
  512. #
  513.  
  514. proc CreateWindow {} {
  515.     global Config Stat
  516.  
  517.     # menu bar
  518.     frame .menu -relief raised -bd 1
  519.     pack .menu -side top -expand 1 -fill x
  520.  
  521.     # File menu
  522.     menubutton .menu.file -text "File" -menu .menu.file.m\
  523.         -underline 0
  524.     menu .menu.file.m
  525.     .menu.file.m add command -label "Open Files" -underline 0\
  526.         -command OpenFiles
  527.     .menu.file.m add command -label "Clear List" -underline 0\
  528.         -command CloseFiles
  529.     .menu.file.m add command -label "Save Config" -underline 0\
  530.         -command SaveConfig
  531.     .menu.file.m add command -label "About" -underline 0\
  532.         -command {
  533.     information "TkMidity -- TiMidty Tcl/Tk Version\n  written by T.IWAI"
  534.     }
  535.     .menu.file.m add command -label "Quit" -underline 0\
  536.         -command QuitCmd
  537.  
  538.     # Mode menu
  539.     menubutton .menu.mode -text "Mode" -menu .menu.mode.m\
  540.         -underline 0
  541.     menu .menu.mode.m
  542.     .menu.mode.m add check -label "Repeat" -underline 0\
  543.         -variable Config(RepeatPlay)
  544.     .menu.mode.m add check -label "Shuffle" -underline 0\
  545.         -variable Config(ShufflePlay) -command "MakeShuffleList"
  546.     .menu.mode.m add check -label "Auto Start" -underline 5\
  547.         -variable Config(AutoStart)
  548.     .menu.mode.m add check -label "Auto Exit" -underline 5\
  549.         -variable Config(AutoExit)
  550.  
  551.     # Displays menu
  552.     menubutton .menu.disp -text "Displays" -menu .menu.disp.m\
  553.         -underline 0
  554.     menu .menu.disp.m
  555.     .menu.disp.m add check -label "File List" -underline 0\
  556.         -variable Config(Disp:file) -command "DispTables"
  557.     .menu.disp.m add check -label "Time" -underline 0\
  558.         -variable Config(Disp:time) -command "DispTables"
  559.     .menu.disp.m add check -label "Messages" -underline 0\
  560.         -variable Config(Disp:text) -command "DispTables"
  561.     .menu.disp.m add check -label "Volume" -underline 0\
  562.         -variable Config(Disp:volume) -command "DispTables"
  563.     .menu.disp.m add check -label "Buttons" -underline 0\
  564.         -variable Config(Disp:button) -command "DispTables"
  565.  
  566.     pack .menu.file .menu.mode .menu.disp -side left
  567.  
  568.     # display body
  569.     if {$Stat(new_tcltk)} {
  570.     frame .body -relief flat
  571.     } else {
  572.     frame .body -relief raised -bd 1 
  573.     }
  574.     pack .body -side top -expand 1 -fill both
  575.  
  576.     # current playing file
  577.     label .body.curfile -text "Playing:" -relief ridge
  578.     pack .body.curfile -side top -expand 1 -fill x
  579.  
  580.     # playing files list
  581.     frame .body.file -relief raised -bd 1
  582.     scrollbar .body.file.bar -relief sunken\
  583.         -command ".body.file.list yview"
  584.     pack .body.file.bar -side right -fill y
  585.     if {$Stat(new_tcltk)} {
  586.     listbox .body.file.list -width 40 -height 10 -relief sunken -bd 2\
  587.         -yscroll ".body.file.bar set"
  588.     } else {
  589.     listbox .body.file.list -geometry 40x10 -relief sunken -bd 2\
  590.         -yscroll ".body.file.bar set"
  591.     }
  592.     bind .body.file.list <Button-1> {SelectList %W %y}
  593.  
  594.     pack .body.file.list -side top -expand 1 -fill both
  595.  
  596.     # time label and scale
  597.     frame .body.time -relief raised -bd 1
  598.     label .body.time.label -text "0:00 / 0:00"
  599.     pack .body.time.label -side top
  600.     scale .body.time.scale -orient horizontal -length 280\
  601.         -from 0 -to 100 -tickinterval 10
  602.     bind .body.time.scale <ButtonRelease-1> {JumpCmd [%W get]}
  603.     pack .body.time.scale -side bottom -expand 1 -fill x
  604.  
  605.     # text browser
  606.     frame .body.text -relief raised -bd 1
  607.     scrollbar .body.text.bar -relief sunken\
  608.         -command ".body.text.buf yview"
  609.     pack .body.text.bar -side right -fill y
  610.     text .body.text.buf -width 40 -height 12 -relief sunken -bd 2\
  611.         -wrap word -yscroll ".body.text.bar set"
  612.     bind .body.text.buf <Button-1> { }
  613.     bind .body.text.buf <Any-Key> { }
  614.     pack .body.text.buf -side top -expand 1 -fill both
  615.     button .body.text.clear -text "Clear"\
  616.         -command ClearMsg
  617.     pack .body.text.clear -side bottom
  618.  
  619.     # volume label and scale
  620.     frame .body.volume -relief raised -bd 1
  621.     label .body.volume.label -text "Volume:"
  622.     pack .body.volume.label -side top
  623.     scale .body.volume.scale -orient horizontal -length 280\
  624.         -from 0 -to 200 -tickinterval 25
  625.     bind .body.volume.scale <ButtonRelease-1> {VolumeCmd [%W get]}
  626.     pack .body.volume.scale -side bottom -expand 1 -fill x
  627.  
  628.     # buttons
  629.     global bitmap_path
  630.     frame .body.button -relief raised -bd 1
  631.     button .body.button.play -bitmap @$bitmap_path/play.xbm\
  632.         -command "PlayCmd"
  633.     button .body.button.stop -bitmap @$bitmap_path/stop.xbm\
  634.         -command "StopCmd"
  635.     button .body.button.prev -bitmap @$bitmap_path/prev.xbm\
  636.         -command "PrevCmd"
  637.     button .body.button.next -bitmap @$bitmap_path/next.xbm\
  638.         -command "NextCmd"
  639.     button .body.button.pause -bitmap @$bitmap_path/pause.xbm\
  640.         -command "PauseCmd"
  641.     button .body.button.quit -bitmap @$bitmap_path/quit.xbm\
  642.         -command "QuitCmd"
  643.     pack .body.button.play .body.button.stop\
  644.         .body.button.prev .body.button.next\
  645.         .body.button.pause .body.button.quit\
  646.         -side left -padx 5 -pady 5
  647.  
  648.     # pack all items
  649.     DispTables
  650.  
  651.     focus .
  652.     tk_menuBar .menu .menu.file .menu.mode .menu.disp
  653.     bind . <Key-Right> "NextCmd"
  654.     bind . <Key-n> "NextCmd"
  655.     bind . <Key-Left> "PrevCmd"
  656.     bind . <Key-p> "PrevCmd"
  657.     bind . <Key-s> "PauseCmd"
  658.     bind . <Key-Down> "VolDownCmd"
  659.     bind . <Key-v> "VolDownCmd"
  660.     bind . <Key-Up> "VolUpCmd"
  661.     bind . <Key-V> "VolUpCmd"
  662.     bind . <Key-space> "PauseCmd"
  663.     bind . <Return> "PlayCmd"
  664.     bind . <Key-c> "StopCmd"
  665.     bind . <Key-q> "QuitCmd"
  666. }
  667.